home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / janus.exe / DLGTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-02  |  10KB  |  326 lines
  1. { Program:   DlgTest
  2.   Version:   1.03
  3.   Purpose:   demonstrates tDialogWindow and tJanusDialogWindow as
  4.              modeless Dialog Windows and MDI child windows.
  5.   Features:  - creates a standard Dialog from BorDlg resource
  6.              - creates a BorDlg from standard resource
  7.              - creates Dialog as is
  8.              - demonstrates the use of "non-standard" MDI child styles
  9.                under Windows 3.1
  10.   Uses:      BWCC.DLL if present. If not: it doesn't matter :-)
  11.   Date:      07/25/92
  12.  
  13.   Developer: Peter Sawatzki (PS)
  14.              Buchenhof 3, D-5800 Hagen 1, Germany
  15.  CompuServe: 100031,3002
  16.  
  17.   Date:     Author:
  18.   04/22/92  PS       initial release
  19.   07/25/92  PS/jwp   added Scroller demo
  20.   08/01/92  PS       fixed some bugs, added modal dialog demo
  21.   08/30/92  PS       add MDI/non-MDI menu item
  22.  
  23.   Copyright (c) 1992 Peter Sawatzki. All Rights Reserved.
  24. }
  25. program DlgTest;
  26.  
  27. {$R DlgTest.Res}
  28. Uses
  29.   WinTypes,
  30.   WinProcs,
  31.   Strings,
  32.   Objects,
  33.   oWindows,
  34.   oPrinter,
  35. {$IfDef Custom} CustomWn, {$EndIf}
  36.   DialogWn;
  37.  
  38. Const
  39.   AppCtl: (MdiApp,NormApp,SwitchApp,TermApp) = MdiApp; {we want a Mdi app first}
  40.  
  41. Type
  42.   {-tJanusDialogWindow with scroller activated}
  43.   pScrollJDW = ^tScrollJDW;
  44.   tScrollJDW = Object(tJanusDialogWindow)
  45.     Constructor Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
  46.   End;
  47.  
  48.   {-tJanusDialogWindow with owner draw listbox}
  49.   pOwnerLBWindow = ^tOwnerLBWindow;
  50.   tOwnerLBWindow = Object(tJanusDialogWindow)
  51.     Procedure SetupWindow; Virtual;
  52.     Procedure wmMeasureItem (Var Msg: tMessage); Virtual wm_First+wm_MeasureItem;
  53.     Procedure wmDrawItem (Var Msg: tMessage); Virtual wm_First+wm_DrawItem;
  54.   End;
  55.  
  56. {-------------------- the scrolling tJanusDialogWindow }
  57.  
  58. Constructor tScrollJDW.Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
  59. Begin
  60.   tJanusDialogWindow.Init(aParent, aName, BorStyle);
  61.   Attr.Style:= Attr.Style Or ws_VScroll Or ws_HScroll;
  62.   Scroller:= New(pScroller, Init(@self,1,1,0,0));
  63. End;
  64.  
  65. {-------------------- the tJanusDialogWindow supporting an owner draw listbox }
  66.  
  67. Procedure tOwnerLBWindow.SetupWindow;
  68.   Procedure AddLb (aString: pChar);
  69.   Begin
  70.     SendDlgItemMessage(hWindow,10,LB_ADDSTRING, 0, LongInt(aString))
  71.   End;
  72. Begin
  73.   tJanusDialogWindow.SetupWindow;
  74.   AddLb(#9'Asterisk');
  75.   AddLb(#9'Exclamation');
  76.   AddLb(#9'Hand');
  77.   AddLb(#9'Question');
  78. End;
  79.  
  80. Procedure tOwnerLBWindow.wmMeasureItem (Var Msg: tMessage);
  81. Begin
  82.   pMeasureItemStruct(Msg.lParam)^.itemHeight:= GetSystemMetrics (SM_CYICON)
  83. End;
  84.  
  85. Procedure tOwnerLBWindow.wmDrawItem (Var Msg: tMessage);
  86. Var
  87.   Tmp: Array[0..60] Of Char;
  88.   anIcon: hIcon;
  89. Begin
  90.  
  91.   With pDrawItemStruct(Msg.lParam)^ Do Begin
  92.     If itemAction And ODA_Focus>0 Then Begin
  93.       DrawFocusRect(hDC,rcItem);
  94.       Exit
  95.     End;
  96.  
  97.     Case itemID Of
  98.       0: anIcon:= LoadIcon(0,idi_Asterisk);
  99.       1: anIcon:= LoadIcon(0,idi_Exclamation);
  100.       2: anIcon:= LoadIcon(0,idi_Hand);
  101.       3: anIcon:= LoadIcon(0,idi_Question);
  102.     Else
  103.       anIcon:= 0
  104.     End;
  105.     SendDlgItemMessage(hWindow,10,lb_GetText,itemID,LongInt(@Tmp));
  106.     DrawText(hDC, Tmp, -1, rcItem, DT_Left+DT_SingleLine+DT_VCenter+DT_ExpandTabs);
  107.     If anIcon<>0 Then
  108.       DrawIcon(hDC, rcItem.left, rcItem.top, anIcon);
  109.   End;
  110. End;
  111.  
  112. Procedure SelectPrinter (aParent: pWindowsObject);
  113. Var
  114.   aPrinter: pPrinter;
  115. Begin
  116.   aPrinter:= New(pPrinter, Init);
  117.   If Not Assigned(aPrinter) Then
  118.     Exit;
  119.   aPrinter^.Setup(aParent);
  120.   Dispose(aPrinter, Done)
  121. End;
  122.  
  123. {-all code for the window creation is in the Dispatch function:
  124.   Dispatch is called from tWindow or tMdiWindow depending if this is an
  125.   'normal' or a MDI application
  126. }
  127. Function Dispatch (aParent: pWindow; Var Msg: tMessage): Boolean;
  128. Var
  129.   aWin: pWindow;
  130. Begin
  131.   aWin:= Nil;
  132.   Case Msg.wParam Of
  133.     $100:  Begin
  134.              AppCtl:= SwitchApp;
  135.              PostMessage(Application^.MainWindow^.hWindow,wm_Close,0,0)
  136.            End;
  137.     $110:  SelectPrinter(aParent);
  138.     $200,$300: aWin:= New(pScrollJDW,Init(aParent, 'aDialog', False)); {standard -> standard}
  139.     $201,$301: aWin:= New(pScrollJDW,Init(aParent, 'aDialog', True));  {standard -> BorDlg}
  140.     $202,$302: aWin:= New(pScrollJDW,Init(aParent, 'aBorDlg', False)); {BorDlg   -> standard}
  141.     $203,$303: aWin:= New(pScrollJDW,Init(aParent, 'aBorDlg', True));  {BorDlg   -> BorDlg}
  142.     $204,$304: aWin:= New(pOwnerLBWindow,Init(aParent, 'unusual', True));  {unusual Dialog}
  143.     $1000:     aWin:= New(pJanusDialogWindow,Init(aParent, 'About',True)); {About Dialog}
  144.   {$IfDef Custom}
  145.     $206:      aWin:= New(pCustomWindow, InitTest(aParent, 'ThickFrame',
  146.                           ws_MinimizeBox+ws_MaximizeBox+ws_ThickFrame+ws_Caption+ws_SysMenu, 1, 1));
  147.     $207:      aWin:= New(pCustomWindow, InitTest(aParent, 'Caption',   ws_Caption+ws_SysMenu, 1, 1));
  148.     $208:      aWin:= New(pCustomWindow, InitTest(aParent, 'DlgFrame',  ws_DlgFrame+ws_SysMenu, 1, 1));
  149.     $209:      aWin:= New(pCustomWindow, InitTest(aParent, 'ThickFrame',
  150.                           ws_MinimizeBox+ws_MaximizeBox+ws_ThickFrame+ws_Caption+ws_SysMenu, 5, 8));
  151.     $20A:      aWin:= New(pCustomWindow, InitTest(aParent, 'Caption',   ws_Caption+ws_SysMenu, 3, 3));
  152.     $20B:      aWin:= New(pCustomWindow, InitTest(aParent, 'DlgFrame',  ws_DlgFrame+ws_SysMenu, 2, 2));
  153.   {$EndIf}
  154.   End;
  155.   If aWin<>Nil Then
  156.     If Hi(Msg.wParam)=$02 Then
  157.       Application^.MakeWindow(aWin)          {modeless}
  158.     Else
  159.       ExecDialogWindow(pDialogWindow(aWin)); {modal}
  160.   Dispatch:= aWin<>Nil
  161. End;
  162.  
  163. {$IfDef Custom}
  164. Procedure AddCustomEntries (aMenu: hMenu);
  165. Var
  166.   aSubMenu: hMenu;
  167. Begin
  168.   aSubMenu:= GetSubMenu(aMenu,1);
  169.   AppendMenu(aSubMenu,mf_Separator,0,Nil);
  170.   AppendMenu(aSubMenu,mf_String,$206,'Custom Window (ThickFrame/small)');
  171.   AppendMenu(aSubMenu,mf_String,$207,'Custom Window (Caption/small)');
  172.   AppendMenu(aSubMenu,mf_String,$208,'Custom Window (DlgFrame/small)');
  173.   AppendMenu(aSubMenu,mf_String,$209,'Custom Window (ThickFrame/large)');
  174.   AppendMenu(aSubMenu,mf_String,$20A,'Custom Window (Caption/large)');
  175.   AppendMenu(aSubMenu,mf_String,$20B,'Custom Window (DlgFrame/large)');
  176. End;
  177. {$EndIf}
  178.  
  179. Procedure PlaceWindow (aWnd: hWnd);
  180. Var
  181.   aRect: tRect;
  182.   width, height: Integer;
  183. Begin
  184.   GetWindowRect(GetDeskTopWindow,aRect);
  185.   With aRect Do Begin
  186.     width:= (right-left) Div 4 * 3;
  187.     height:= (bottom-top) Div 4 * 3;
  188.     Inc(left,(right-left) Div 8);
  189.     Inc(top, (bottom-top) Div 8);
  190.     MoveWindow(aWnd,left, top, width, height, False)
  191.   End
  192. End;
  193.  
  194. {-------------------- the MDI part }
  195.  
  196. Type
  197.   paMDIWindow = ^aMDIWindow;
  198.   aMDIWindow = object(tMDIWindow)
  199.     Procedure SetupWindow; Virtual;
  200.     Procedure InitClientWindow; Virtual;
  201.     Procedure DefCommandProc (Var Msg: tMessage); Virtual;
  202.   End;
  203.  
  204. Procedure aMDIWindow.SetupWindow;
  205. Begin
  206.   tMDIWindow.SetupWindow;
  207.   SetFlags(wb_Kbhandler,True);
  208. {$IfDef PScc} AddPSccEntries(Attr.Menu); {$EndIf}
  209. {$IfDef Custom} AddCustomEntries(Attr.Menu); {$EndIf}
  210.   PlaceWindow(hWindow)
  211. End;
  212.  
  213.  
  214. Procedure aMDIWindow.InitClientWindow;
  215. Begin
  216.  ClientWnd:= New(pMdiClient, Init(@Self));
  217.  With ClientWnd^.Attr do
  218.    Style:= Style or WS_VSCROLL or WS_HSCROLL Or 1 {mdis_AllChildStyles = $0001}
  219. End;
  220.  
  221. Procedure aMDIWindow.DefCommandProc (Var Msg: tMessage);
  222. Begin
  223.   If Not Dispatch(@Self,Msg) Then
  224.     tMDIWindow.DefCommandProc(Msg)
  225. End;
  226.  
  227. {-------------------- the normal window part }
  228.  
  229. Type
  230.   paWindow = ^aWindow;
  231.   aWindow = Object(tWindow)
  232.     Constructor Init (aParent: pWindowsObject; aTitle: pChar);
  233.     Procedure SetupWindow; Virtual;
  234.     Procedure GetWindowClass(var WndClass: TWndClass); virtual;
  235.     Procedure DefCommandProc (Var Msg: tMessage); Virtual;
  236.   End;
  237.  
  238. Constructor aWindow.Init (aParent: pWindowsObject; aTitle: pChar);
  239. Var
  240.   i: Word;
  241. Begin
  242.   tWindow.Init(aParent, aTitle);
  243.   Attr.Menu:= LoadMenu(hInstance,'aMenu');
  244.   For i:= cm_ArrangeIcons To cm_CloseChildren Do
  245.     EnableMenuItem(Attr.Menu,i,mf_ByCommand+mf_Disabled+mf_Grayed);
  246.   ModifyMenu(Attr.Menu, $100, mf_ByCommand, $100, '&Switch